home *** CD-ROM | disk | FTP | other *** search
Text File | 2000-09-28 | 24.9 KB | 779 lines | [TEXT/CWIE] |
- unit ICMiscSubs;
-
- (* This file is part of the Internet Configuration system and is placed in the public domain for the benefit of all.
-
- This file holds all those miscellaneous little functions that are basically wrappers
- around existing OS functionality.
- *)
-
- interface
-
- uses
- Files,
- Windows,
- Lists,
- AppleEvents,
-
- InternetConfig;
-
- (* ***** QuickDraw Stuff ***** *)
-
- procedure DrawIcon (resourceID: integer; const iconRect: Rect; drawHighlighted: Boolean);
- (* This routine draws in icon from the resources specified by resourceID.
- If the System 7 icon utilities are available, it uses the icon family
- resources 'icl8', and draws using the icon utilities. If they're not available,
- it uses the 'ICN#' resource and draws using PlotIcon.
- *)
-
- procedure MagicMarkerMode;
- (* This routine sets the HiliteMode low memory global such that the
- next invert operation is done using the user specified highlight colour.
- If Colour QuickDraw isn't available, it does nothing.
- *)
-
- (* ***** Event Manager Stuff ***** *)
-
- function DirtyKey (typedChar: char): Boolean;
- (* This function returns true if the given character will cause a Text
- Edit field to become dirty, ie it's a character that will go into
- the field rather than move the insertion point.
- *)
-
- function IsKeyDown (keyCode: integer): Boolean;
- (* Returns true if the given virtual key is down. *)
-
- (* ***** Window Manager Stuff ***** *)
-
- (* EnterWindow, ExitWindow and the SavedWindowState type are used to implement
- a standard mechanism for saving and restoring window information. You call
- EnterWindow when you want to work on a window. This sets up the parameters
- you need and saves the old parameters in the SavedWindowState variable.
- You then call ExitWindow to restore that state.
- *)
-
- type
- SavedWindowInfo =
- record
- oldPort: GrafPtr;
- thisPort: GrafPtr;
- font: integer;
- size: integer;
- face: Style;
- end;
-
- procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style;
- var saved: SavedWindowInfo);
- (* Set thePort to window and establish the various window state parameters.
- Save the old parameters in saved.
- *)
-
- procedure ExitWindow (const saved: SavedWindowInfo);
- (* Recover the window parameters from saved. *)
-
- function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
- (* Returns the window's content region. This is the region currently
- being used, not a copy. Do not munge it!
- *)
-
- function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
- (* Returns the window's structure region. This is the region currently
- being used, not a copy. Do not munge it!
- *)
-
- function TitleBarOnScreen (theWindow: WindowPtr): Boolean;
- (* Returns true if the window's title bar is on the screen.
- Note that this routine only works if the window is visible,
- ie you have called ShowWindow on it. The standard mechanism
- for using this routine is to ShowWindow the window, then
- call TitleBarOnScreen. If it returns true, everything is cool.
- Otherwise the window is completely off the screen, so you can
- move it back on without causing visible effects.
- *)
-
- procedure GetWindowRect (theWindow: WindowPtr; var windowRect: Rect);
- (* This routine sets windowRect to the global co-ordinates of
- the position of the window. It's typically used for saving window
- state.
- *)
-
- (* ***** Menu Manager Stuff ***** *)
-
- procedure SetMenuItemEnable (menuH: MenuHandle; item: integer; enable: Boolean);
- (* Enable the item in the MenuHandle if enable is set, disable it otherwise.
- You've gotta wonder why this isn't in the operating system!
- *)
-
- function FindMenuItem (menuH: MenuHandle; itemTextToSearchFor: Str255;
- var indexOfItemFound: integer): Boolean;
- (* This routine searches through the Menu Handle looking for
- itemTextToSearchFor. If it finds it, it returns true and sets
- indexOfItemFound to the position of the matching menu item.
- *)
-
- (* ***** List Manager Stuff ***** *)
-
- (* All of these List Manager routines are really targetted at one dimensional
- vertical lists. They don't work well for two dimensional or horizontal
- lists.
- *)
-
- procedure InitListManagerMiscSubs;
- (* The LDoKey function requires a bunch of global state to implement
- it's "select by typing" function. This routine initialises that
- information.
- *)
-
- procedure LSetNoSelection (listH: ListHandle);
- (* This routine clears any selection in the list. *)
-
- procedure LSelectAll(listH: ListHandle);
- (* This routine selects the entire contents of the list. *)
-
- procedure LSetSingleSelection (listH: ListHandle; row: integer);
- (* This routine selects the single cell (0, row) in the list. *)
-
- (* The LDoKey routine takes a procedural parameter that is uses to fetch
- the text associated with an item in the list so that it can implement
- its "select by typing" function.
- *)
- type
- GetListCellTextProcType = procedure(listH: ListHandle; listCell: Cell; var cellText: Str255);
-
- procedure LDoKey(listH: ListHandle; var event:EventRecord; getCellText: GetListCellTextProcType);
- (* This routine processes a key event associated with a list, including
- "select by typing". You can disable this function by passing nil to
- getCellText.
- *)
-
- function LSelectedLine (lh: ListHandle): integer;
- (* This function returns the vertical position of the first selected
- cell in the list, or -1 if there is no selected cell.
- *)
-
- function LIsEmpty (lh: ListHandle): Boolean;
- (* This function returns true if the list is empty. *)
-
- (* ***** Truly Misc Stuff ***** *)
-
- function AEGotRequiredParams (const theAppleEvent: AppleEvent): OSStatus;
- (* Returns no error if you've extracted all of the required
- parameters out of the AppleEvent.
- *)
-
- implementation
-
- uses
- Icons,
- Errors,
- Resources,
- Dialogs,
- ToolUtils,
- Traps,
- LowMem,
- GestaltEqu,
- StringCompare,
-
- InternetConfig,
-
- ICCommonSubs;
-
- (* ***** QuickDraw Stuff ***** *)
-
- procedure DrawIcon (resourceID: integer; const iconRect: Rect; drawHighlighted: Boolean);
- (* See comment in interface part. *)
- var
- junk: OSStatus;
- iconSuite: Handle;
- transform: integer;
- iconH: Handle;
- tmpIconRect : Rect;
- begin
- tmpIconRect := iconRect;
- if GetIconSuite(iconSuite, resourceID, svAllLargeData) = noErr then begin
- if drawHighlighted then begin
- transform := ttSelected;
- end else begin
- transform := ttNone;
- end; (* if *)
- junk := PlotIconSuite(tmpIconRect, 0, transform, iconSuite);
- junk := DisposeIconSuite(iconSuite, false);
- end else begin
- iconH := Get1Resource('ICN#', resourceID);
- if iconH <> nil then begin
- PlotIcon(tmpIconRect, iconH);
- end; (* if *)
- end; (* if *)
- end; (* DrawIcon *)
-
- procedure MagicMarkerMode;
- (* See comment in interface part. *)
- var
- hasColourQD : Boolean;
- response : longint;
- begin
- hasColourQD := (Gestalt(gestaltQuickdrawVersion, response) = noErr) &
- (response >= gestalt8BitQD);
- if hasColourQD then begin
- LMSetHiliteMode(band(LMGetHiliteMode, $7F));
- end; (* if *)
- end; (* MagicMarkerMode *)
-
- (* ***** Event Manager Stuff ***** *)
-
- function DirtyKey (typedChar: char): Boolean;
- (* See comment in interface part. *)
- begin
- DirtyKey := not(typedChar in [kHomeChar, kEndChar, kHelpChar, kPageUpChar, kPageDownChar,
- kLeftArrowChar, kRightArrowChar, kUpArrowChar, kDownArrowChar]);
- end; (* DirtyKey *)
-
- function IsKeyDown (keyCode: integer): Boolean;
- (* See comment in interface part. *)
- var
- currentKeys: KeyMap;
- begin
- GetKeys(currentKeys);
- IsKeyDown := currentKeys[keyCode];
- end; (* IsKeyDown *)
-
- (* ***** Window Manager Stuff ***** *)
-
- procedure EnterWindow (window: WindowPtr; font, size: integer; face: Style;
- var saved: SavedWindowInfo);
- (* See comment in interface part. *)
- begin
- GetPort(saved.oldPort);
- SetPort(window);
- saved.thisPort := window;
- saved.font := window^.txFont;
- saved.size := window^.txSize;
- saved.face := window^.txFace;
- TextFont(font);
- TextSize(size);
- TextFace(face);
- end; (* EnterWindow *)
-
- procedure ExitWindow (const saved: SavedWindowInfo);
- (* See comment in interface part. *)
- begin
- SetPort(saved.thisPort);
- TextFont(saved.font);
- TextSize(saved.size);
- TextFace(saved.face);
- SetPort(saved.oldPort);
- end; (* ExitWindow *)
-
- function GetWindowContentRegion (theWindow: WindowPtr): RgnHandle;
- (* See comment in interface part. *)
- begin
- GetWindowContentRegion := WindowPeek(theWindow)^.contRgn;
- end; (* GetWindowContentRegion *)
-
- function GetWindowStructureRegion (theWindow: WindowPtr): RgnHandle;
- (* See comment in interface part. *)
- begin
- GetWindowStructureRegion := WindowPeek(theWindow)^.strucRgn;
- end; (* GetWindowStructureRegion *)
-
- function TitleBarOnScreen (theWindow: WindowPtr): Boolean;
- (* See comment in interface part. *)
- var
- result : Boolean;
- titleBarRegion: RgnHandle;
- begin
- result := true;
- titleBarRegion := NewRgn;
- if titleBarRegion <> nil then begin
- (* First calculate the title bar region by subtracting the content
- region away from the structure region.
- *)
- CopyRgn(GetWindowStructureRegion(theWindow), titleBarRegion);
- DiffRgn(titleBarRegion, GetWindowContentRegion(theWindow), titleBarRegion);
-
- (* Now intersect the title bar region with the grey region, ie the region
- describing the extent of the desktop and return true if the intersection
- is not empty.
- *)
- SectRgn(titleBarRegion, GetGrayRgn, titleBarRegion);
- result := not EmptyRgn(titleBarRegion);
- DisposeRgn(titleBarRegion);
- end; (* if *)
- TitleBarOnScreen := result;
- end; (* TitleBarOnScreen *)
-
- procedure GetWindowRect (theWindow: WindowPtr; var windowRect: Rect);
- (* See comment in interface part. *)
- var
- oldPort : GrafPtr;
- begin
- GetPort(oldPort);
- SetPort(theWindow);
- windowRect := WindowPeek(theWindow)^.port.portRect;
- LocalToGlobal(windowRect.topLeft);
- LocalToGlobal(windowRect.botRight);
- SetPort(oldPort);
- end; (* GetWindowRect *)
-
- (* ***** Menu Manager Stuff ***** *)
-
- procedure SetMenuItemEnable (menuH: MenuHandle; item: integer; enable: Boolean);
- (* See comment in interface part. *)
- begin
- if enable then begin
- EnableItem(menuH, item);
- end else begin
- DisableItem(menuH, item);
- end; (* if *)
- end; (* SetMenuItemEnable *)
-
- function FindMenuItem (menuH: MenuHandle; itemTextToSearchFor: Str255;
- var indexOfItemFound: integer): Boolean;
- (* See comment in interface part. *)
- var
- itemIndex: integer;
- itemText: Str255;
- begin
- FindMenuItem := false;
- for itemIndex := 1 to CountMItems(menuH) do begin
- GetMenuItemText(menuH, itemIndex, itemText);
- if IdenticalString(itemText, itemTextToSearchFor, nil) = 0 then begin
- indexOfItemFound := itemIndex;
- FindMenuItem := true;
- end; (* if *)
- end; (* for *)
- end; (* FindMenuItem *)
-
- (* ***** List Manager Stuff ***** *)
-
- var
- gCharsTypedSoFar: Str255;
- gTimeOfLastCharTyped: longint;
- gListHandleOfLastCharTyped: ListHandle;
-
- procedure InitListManagerMiscSubs;
- (* See comment in interface part. *)
- begin
- gCharsTypedSoFar := '';
- gTimeOfLastCharTyped := 0;
- gListHandleOfLastCharTyped := nil;
- end; (* InitListManagerMiscSubs *)
-
- procedure LSetNoSelection (listH: ListHandle);
- (* See comment in interface part. *)
- var
- listCell: Cell;
- begin
- listCell.v := 0;
- listCell.h := 0;
- while LGetSelect(true, listCell, listH) do begin
- LSetSelect(false, listCell, listH);
- listCell.v := listCell.v + 1;
- listCell.h := 0;
- end; (* if *)
- end; (* LSetNoSelection *)
-
- procedure LSelectAll(listH: ListHandle);
- var
- listCell: Cell;
- row: integer;
- begin
- for row := 0 to listH^^.dataBounds.bottom - 1 do begin
- listCell.v := row;
- listCell.h := 0;
- LSetSelect(true, listCell, listH);
- end; (* for *)
- end; (* LSelectAll *)
-
- procedure LSetSingleSelection (listH: ListHandle; row: integer);
- (* See comment in interface part. *)
- var
- listCell: Cell;
- begin
- listCell.h := 0;
- listCell.v := row;
- LSetSelect(true, listCell, listH);
- listCell.v := 0;
- listCell.h := 0;
- while LGetSelect(true, listCell, listH) do begin
- if listCell.v <> row then begin
- LSetSelect(false, listCell, listH);
- end; (* if *)
- listCell.v := listCell.v + 1;
- listCell.h := 0;
- end; (* while *)
- LAutoScroll(listH);
- end; (* LSetSingleSelection *)
-
- function LGetUniqueEntryName (listH: ListHandle; listCell: Cell; getCellText: GetListCellTextProcType): Str255;
- (* This function calls getCellText and then returns a 'uniquified' version of the
- cell text. What that means is that it returns the cell text followed by
- a chr(0) followed by the the vertical co-ordinate of the cell encoded
- as two characters. This is useful because it allows functions that
- need to distinguish between two cells even if they have the same
- name to function, eg tabbing.
- *)
- var
- result: Str255;
- begin
- result := '';
- getCellText(listH, listCell, result);
- LGetUniqueEntryName := concat(result, chr(0),
- chr(listCell.v div 256),
- chr(listCell.v mod 256));
- end; (* LGetUniqueEntryName *)
-
- function LGetSelectedCellCommon (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType;
- first : Boolean): Boolean;
- (* This function finds the alphabetically first or last cell (depending
- on the value of first) in the currently selected cells of the list. It
- returns false if there are no selected cells.
- *)
- var
- result : Boolean;
- cellText: Str255;
- bestText : Str255;
- indexOfBestText: integer;
- begin
- (* Establish some pre-conditions. *)
- result := false;
- listCell.h := 0;
- listCell.v := 0;
- indexOfBestText := 0;
- if first then begin
- bestText := concat(chr(255), chr(255));
- end else begin
- bestText := '';
- end; (* if *)
-
- (* Loop through the selected cells, looking for the best text (ie the
- alphabetically first or last).
- *)
- while LGetSelect(true, listCell, listH) do begin
- result := true;
- getCellText(listH, listCell, cellText);
- if (first & (IUCompString(cellText, bestText) < 0)) |
- (not first & (IUCompString(cellText, bestText) > 0)) then begin
- indexOfBestText := listCell.v;
- bestText := cellText;
- end; (* if *)
- listCell.v := listCell.v + 1;
- end; (* while *)
-
- (* Finish up. *)
- listCell.h := 0;
- listCell.v := indexOfBestText;
- LGetSelectedCellCommon := result;
- end; (* LGetSelectedCellCommon *)
-
- function LGetFirstSelectedCell (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType): Boolean;
- (* This function finds the alphabetically first cell in the currently
- selected cells of the list. It returns false if there are no selected cells.
- *)
- begin
- LGetFirstSelectedCell := LGetSelectedCellCommon(listH, listCell, getCellText, true);
- end; (* LGetFirstSelectedCell *)
-
- function LGetLastSelectedCell (listH: ListHandle; var listCell: Cell; getCellText: GetListCellTextProcType): Boolean;
- (* This function finds the alphabetically last cell in the currently
- selected cells of the list. It returns false if there are no selected cells.
- *)
- begin
- LGetLastSelectedCell := LGetSelectedCellCommon(listH, listCell, getCellText, false);
- end; (* LGetLastSelectedCell *)
-
- function LSelectFirstCommon (listH: ListHandle; markerText: Str255; getCellText: GetListCellTextProcType;
- before : Boolean; orEqual : Boolean): Boolean;
- (* This function selects the first cell alphabetically before (or after, depending
- on the value of "before") the markerText. If returns true if it managed to do this,
- false otherwise. The orEqual value determines whether an
- equal value is considered to be before the otherwise best value.
- *)
- var
- result: Boolean;
- row : integer;
- indexOfBestText: integer;
- listCell: Cell;
- bestText : Str255;
- cellText: Str255;
- comp1 : integer;
- comp2 : integer;
- begin
- (* Establish some pre-conditions. *)
- result := false;
- indexOfBestText := 0;
- if before then begin
- bestText := '';
- end else begin
- bestText := concat(chr(255), chr(255));
- end; (* if *)
-
- (* Iterate through all the cells, looking for best text. Best is defined
- as the phone that's alphabetically before (or after, depending on
- the value of before) the markerText.
- *)
- for row := 0 to listH^^.dataBounds.bottom - 1 do begin
- listCell.h := 0;
- listCell.v := row;
- getCellText(listH, listCell, cellText);
-
- (* OK, so this needs some explaning (-:
- comp1 and comp2 just cache the value of the comparisons between
- markerText, cellText and bestText.
-
- If before is true, we're looking for the cell immediately before
- the markerText. This means that the markerText must be
- greater than (ie "comp1 > 0") or equal to (ie "| (comp1 = 0)")
- the cellText, and the cellText must be greater than (ie "comp2 > 0")
- the bestText we've found so far.
-
- If before is false, we're looking for the cell immediately after
- the markerText. This means that the markerText must be
- less than (ie "comp1 < 0") or equal to (ie "| (comp1 = 0)")
- the cellText, and the cellText must be less than (ie "comp2 < 0")
- the bestText we've found so far.
-
- *phew*
- *)
- comp1 := IUCompString(markerText, cellText);
- comp2 := IUCompString(cellText, bestText);
- if ( before & (((comp1 > 0) | ((comp1 = 0) & orEqual)) & (comp2 > 0))) |
- (not before & (((comp1 < 0) | ((comp1 = 0) & orEqual)) & (comp2 < 0))) then begin
- bestText := cellText;
- indexOfBestText := listCell.v;
- result := true;
- end; (* if *)
- end; (* for *)
-
- (* Now set the selection to the cell we found. *)
- if result then begin
- LSetSingleSelection(listH, indexOfBestText);
- end; (* if *)
- LSelectFirstCommon := result;
- end; (* LSelectFirstCommon *)
-
- function LSelectFirstBefore (listH: ListHandle; beforeThis: Str255; getCellText: GetListCellTextProcType): Boolean;
- (* This function selects the first cell alphabetically before
- the beforeThis text. If returns true if it managed to do this,
- false otherwise. The orEqual value determines whether an
- equal value is considered to be before the otherwise best value.
- *)
- begin
- LSelectFirstBefore := LSelectFirstCommon(listH, beforeThis, getCellText, true, false);
- end; (* LSelectFirstBefore *)
-
- function LSelectFirstAfter (listH: ListHandle; afterThis: Str255; getCellText: GetListCellTextProcType; orEqual:Boolean): Boolean;
- (* This function selects the first cell alphabetically after
- the afterThis text. If returns true if it managed to do this,
- false otherwise. The orEqual value determines whether an
- equal value is considered to be before the otherwise best value.
- *)
- begin
- LSelectFirstAfter := LSelectFirstCommon(listH, afterThis, getCellText, false, orEqual);
- end; (* LSelectFirstAfter *)
-
- procedure LDownArrow(listH : ListHandle);
- (* Find the last selected cell and select the cell after it. *)
- var
- listCell : Cell;
- indexOfCellToSelect : integer;
- begin
- listCell.h := 0;
- listCell.v := 0;
- indexOfCellToSelect := 0;
- while LGetSelect(true, listCell, listH) do begin
- listCell.v := listCell.v + 1;
- indexOfCellToSelect := listCell.v;
- end; (* if *)
- if indexOfCellToSelect >= listH^^.dataBounds.bottom then begin
- indexOfCellToSelect := listH^^.dataBounds.bottom - 1;
- end; (* if *)
- LSetSingleSelection(listH, indexOfCellToSelect);
- LAutoScroll(listH);
- end; (* LDownArrow *)
-
- procedure LUpArrow(listH : ListHandle);
- (* Find the first selected cell and select the cell before it. *)
- var
- listCell : Cell;
- begin
- listCell.h := 0;
- listCell.v := 0;
- if not LGetSelect(true, listCell, listH) then begin
- listCell.v := listH^^.dataBounds.bottom;
- end; (* if *)
- if listCell.v > 0 then begin
- listCell.v := listCell.v - 1;
- end; (* if *)
- LSetSingleSelection(listH, listCell.v);
- LAutoScroll(listH);
- end; (* LUpArrow *)
-
- procedure LTab(listH : ListHandle; getCellText: GetListCellTextProcType; shift : Boolean);
- (* Handle Tab and shift-Tab keys in the list. *)
- var
- junkBool : Boolean;
- listCell : Cell;
- done : Boolean;
- selectedCellText : Str255;
- begin
- if getCellText <> nil then begin
- if not shift then begin
- (* Tab -- If there are selected cells then attempt to select the first
- cell after the last selected cell. If we can't or there were no
- selected cells, then select the first cell alphabetically.
- *)
- done := false;
- if LGetLastSelectedCell(listH, listCell, getCellText) then begin
- selectedCellText := LGetUniqueEntryName(listH, listCell, getCellText);
- if LSelectFirstAfter(listH, selectedCellText, getCellText, false) then begin
- done := true;
- end; (* if *)
- end; (* if *)
- if not done then begin
- junkBool := LSelectFirstAfter(listH, '', getCellText, false);
- end; (* if *)
- end else begin
- (* shift-Tab -- If there are no selected cells then attempt to select the
- cell before the first selected cell. If we can't or there were no
- selected cells, then select the last cell alphabetically.
- *)
- done := false;
- if LGetFirstSelectedCell(listH, listCell, getCellText) then begin
- getCellText(listH, listCell, selectedCellText);
- if LSelectFirstBefore(listH, selectedCellText, getCellText) then begin
- done := true;
- end; (* if *)
- end; (* if *)
- if not done then begin
- junkBool := LSelectFirstBefore(listH, chr(255), getCellText);
- end; (* if *)
- end; (* if *)
- end; (* if *)
- end; (* LTab *)
-
- procedure LOtherKey(listH : ListHandle; getCellText : GetListCellTextProcType;
- typedChar : char; eventTicks : longint);
- (* This routine handles the pressing of a normaly key in a list
- by selecting the cell best associated with the text typed so far.
- *)
- var
- junkBool : Boolean;
- begin
- if (getCellText <> nil) & (typedChar >= ' ') then begin
- if eventTicks - gTimeOfLastCharTyped > 60 then begin
- gCharsTypedSoFar := '';
- end; (* if *)
- gTimeOfLastCharTyped := eventTicks;
- gCharsTypedSoFar := concat(gCharsTypedSoFar, typedChar);
- if not LSelectFirstAfter(listH, gCharsTypedSoFar, getCellText, true) then begin
- junkBool := LSelectFirstBefore(listH, chr(255), getCellText);
- end; (* if *)
- end; (* if *)
- end; (* LOtherKey *)
-
- procedure LDoKey(listH: ListHandle; var event:EventRecord; getCellText: GetListCellTextProcType);
- (* See comment in interface part. *)
- var
- eventTicks: longint;
- typedChar:char;
- begin
- eventTicks := event.when;
- typedChar := chr(band(event.message, charCodeMask));
-
- (* First up, if we've changed lists or typed a control character,
- we reset the globals that track the current typing state.
- *)
- if (gListHandleOfLastCharTyped <> listH) or (typedChar < ' ') then begin
- gTimeOfLastCharTyped := 0;
- gListHandleOfLastCharTyped := listH;
- end; (* if *)
-
- (* Now dispatch the various characters type. *)
- case typedChar of
- (* Handle the trivial scrolling around keys. *)
- kHomeChar:
- LScroll(0, -listH^^.dataBounds.bottom, listH);
- kEndChar:
- LScroll(0, listH^^.dataBounds.bottom, listH);
- kPageUpChar:
- LScroll(0, -(listH^^.visible.bottom - listH^^.visible.top - 2), listH);
- kPageDownChar:
- LScroll(0, (listH^^.visible.bottom - listH^^.visible.top - 2), listH);
-
- (* Handle up and down arrows. *)
- kDownArrowChar:
- LDownArrow(listH);
- kUpArrowChar:
- LUpArrow(listH);
-
- (* Tab and shift-Tab and other keys are trickier. *)
- kTabChar:
- LTab(listH, getCellText, band(event.modifiers, shiftKey) <> 0);
- otherwise
- LOtherKey(listH, getCellText, typedChar, eventTicks);
- end; (* case *)
- end; (* LDoKey *)
-
- function LSelectedLine (lh: ListHandle): integer;
- (* See comment in interface part. *)
- var
- listCell: Cell;
- begin
- SetPt(listCell, 0, 0);
- if LGetSelect(true, listCell, lh) then begin
- LSelectedLine := listCell.v;
- end else begin
- LSelectedLine := -1;
- end; (* if *)
- end; (* LSelectedLine *)
-
- function LIsEmpty (lh: ListHandle): Boolean;
- (* See comment in interface part. *)
- begin
- LIsEmpty := lh^^.dataBounds.bottom <= lh^^.dataBounds.top;
- end; (* LIsEmpty *)
-
- (* ***** Truly Misc Stuff ***** *)
-
- function AEGotRequiredParams (const theAppleEvent: AppleEvent): OSStatus;
- (* See comment in interface part. *)
- var
- typeCode: DescType;
- actualSize: Size;
- err: OSStatus;
- tmpAppleEvent : AppleEvent;
- begin
- tmpAppleEvent := theAppleEvent;
- err := AEGetAttributePtr(tmpAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);
- if err = errAEDescNotFound then begin
- err := noErr;
- end else if err = noErr then begin
- err := errAEEventNotHandled;
- end; (* if *)
- AEGotRequiredParams := err;
- end; (* AEGotRequiredParams *)
-
- function NumToolboxTraps: integer;
- (* Returns the number of toolbox traps on this machine. *)
- begin
- if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then begin
- NumToolboxTraps := $200
- end else begin
- NumToolboxTraps := $400;
- end; (* if *)
- end; (* NumToolboxTraps *)
-
- function GetTrapType (theTrap: integer): TrapType;
- (* Returns the trap type associated with the given A-Trap number. *)
- const
- TrapMask = $0800;
- begin
- if band(theTrap, TrapMask) > 0 then begin
- GetTrapType := ToolTrap
- end else begin
- GetTrapType := OSTrap;
- end; (* if *)
- end; (* GetTrapType *)
-
- end. (* ICMiscSubs *)
-